home *** CD-ROM | disk | FTP | other *** search
/ Packard Bell - Internet on a CD / internet on a cd.cdr / Internet / sites / Clementine_NASA / image.hqx / Image folder / Macros / Stacks < prev    next >
Encoding:
Text File  |  1991-08-09  |  8.0 KB  |  403 lines
  1. {This file contains macros that work with stacks.}
  2.  
  3.  
  4. macro 'Add Slice [A]';    begin AddSlice end;
  5. macro 'Delete Slice [D]'; begin DeleteSlice end;
  6.  
  7.  
  8. procedure CheckForStack;
  9. begin
  10.   if nSlices=0 then begin
  11.     PutMessage('This window is not a stack');
  12.     exit;
  13.   end;
  14. end;
  15.  
  16.  
  17. macro 'Smooth';
  18. var
  19.   i:integer;
  20. begin
  21.   CheckForStack;
  22.   for i:= 1 to nSlices do begin
  23.     SelectSlice(i);
  24.     Smooth;
  25.   end;
  26. end;
  27.  
  28.  
  29. macro 'Sharpen';
  30. var
  31.   i:integer;
  32. begin
  33.   CheckForStack;
  34.   for i:= 1 to nSlices do begin
  35.     SelectSlice(i);
  36.     SetOption; Smooth;
  37.     SetOption; Sharpen;
  38.   end;
  39. end;
  40.  
  41.  
  42. macro 'Remove 0 and 255';
  43. {
  44. Changes 0 to 1 and 255 to 254 in all slices. We want to do this because
  45. pixel values of 0(which always displays as white) and 255(always
  46. displays as black) cause problems when pseudo-coloring images.
  47. }
  48. var
  49.   i:integer;
  50. begin
  51.   CheckForStack;
  52.   for i:= 1 to nSlices do begin
  53.     SelectSlice(i);
  54.     ChangeValues(0,0,1);
  55.     ChangeValues(255,255,254);
  56.   end;
  57. end;
  58.  
  59.  
  60. procedure flip(vertical:boolean);
  61. var
  62.   i:integer;
  63. begin
  64.   CheckForStack;
  65.   for i:= 1 to nSlices do begin
  66.     SelectSlice(i);
  67.     if vertical
  68.       then FlipVertical
  69.       else FlipHorizontal;
  70.   end;
  71. end;
  72.  
  73. macro 'Flip Vertical';   begin flip(true) end;
  74. macro 'Flip Horizontal'; begin flip(false) end;
  75.  
  76.  
  77. procedure CheckForSelection;
  78. var 
  79.   x1,y1,x2,y2,LineWidth:integer;
  80. begin
  81.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  82.   GetLine(x1,y1,x2,y2,LineWidth);
  83.   if (RoiWidth=0) or (x1>=0) then begin
  84.     PutMessage('Please make a rectangular selection.');
  85.     exit;
  86.   end;
  87. end;
  88.  
  89.  
  90. procedure Rotate(left:boolean);
  91. var
  92.   i,OldStack,NewStack:integer;
  93.   RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  94.   N,NewWidth:integer;
  95.   ScaleFactor:real;
  96.   OneToOne:boolean;
  97. begin
  98.   CheckForStack;
  99.   SelectAll;
  100.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  101.   OldStack:=PicNumber;
  102.   N:=nSlices;
  103.   SetNewSize(RoiHeight,RoiWidth);
  104.   MakeNewStack('Stack');
  105.   NewStack:=PicNumber;
  106.   SelectPic(OldStack);
  107.   for i:= 1 to N do begin
  108.     SelectSlice(1);
  109.     if left
  110.       then RotateLeft(true)
  111.       else RotateRight(true);
  112.     SelectAll;
  113.     Copy;
  114.     SelectPic(NewStack);
  115.     if i<>1 then AddSlice;
  116.     Paste;
  117.     ChoosePic(nPics);
  118.     Dispose;
  119.     SelectPic(OldStack);
  120.     DeleteSlice;
  121.   end;
  122.   Dispose;
  123. end;
  124.  
  125. macro 'Rotate Left';  begin rotate(true) end;
  126. macro 'Rotate Right'; begin rotate(false) end;
  127.  
  128.  
  129. procedure CropAndScale(fast:boolean);
  130. var
  131.   i,OldStack,NewStack:integer;
  132.   RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  133.   N,NewWidth:integer;
  134.   ScaleFactor:real;
  135.   OneToOne:boolean;
  136. begin
  137.   CheckForStack;
  138.   CheckForSelection;
  139.   SaveState;
  140.   OldStack:=PicNumber;
  141.   N:=nSlices;
  142.   ScaleFactor:=GetNumber('Scale factor[1.0]:',1.0);
  143.   OneToOne:=ScaleFactor=1.0;
  144.   NewWidth:=round(RoiWidth*ScaleFactor);
  145.   if odd(NewWidth) then begin
  146.     NewWidth:=NewWidth-1;
  147.     ScaleFactor:=NewWidth/RoiWidth;
  148.   end;
  149.   SetNewSize(RoiWidth*ScaleFactor,RoiHeight*ScaleFactor);
  150.   MakeNewStack('Stack');
  151.   NewStack:=PicNumber;
  152.   if not OneToOne then begin
  153.     if fast 
  154.       then SetScaling('Nearest; Create New Window')
  155.       else SetScaling('Bilinear; Create New Window');
  156.   end;
  157.   SelectPic(OldStack);
  158.   for i:= 1 to N do begin
  159.     SelectSlice(1);
  160.     if OneToOne then Duplicate('Temp')
  161.       else ScaleAndRotate(ScaleFactor,ScaleFactor,0);
  162.     SelectAll;
  163.     Copy;
  164.     SelectPic(NewStack);
  165.     if i<>1 then AddSlice;
  166.     Paste;
  167.     ChoosePic(nPics);
  168.     Dispose;
  169.     SelectPic(OldStack);
  170.     DeleteSlice;
  171.   end;
  172.   Dispose;
  173.   RestoreState;
  174. end;
  175.  
  176. macro 'Crop and Scale-Fast';   begin CropAndScale(true); end;
  177. macro 'Crop and Scale-Smooth'; begin CropAndScale(false); end;
  178.  
  179.  
  180. macro 'Delete Even Slices';
  181. var
  182.   n:integer;
  183. begin
  184.   CheckForStack;
  185.   SelectSlice(2);
  186.   repeat
  187.     DeleteSlice;
  188.     n:=SliceNumber;
  189.     n:=n+2;
  190.     if n>nSlices then exit;
  191.     SelectSlice(n);
  192.    until false;
  193. end;
  194.  
  195.  
  196. macro 'Merge Two Stacks';
  197. {
  198. Combines two stacks(w1xh1xd1 and w2xh2xd2) to create a new
  199. w1+w2 x max(h1,h2) x max(d1,d2) stack. For example, a 256x256x40
  200. and a 256x256x30 stack would be combined into one 512x256x40 stack.
  201. }
  202. var
  203.   i,w1,w2,w3,h1,h2,h3,d1,d2,d3:integer;
  204. begin
  205.   SaveState;
  206.   if nPics<>2 then begin
  207.     PutMessage('This macro operates on exactly two stacks.');
  208.     exit;
  209.   end;
  210.   SelectPic(1);
  211.   GetPicSize(w1,h1);
  212.   d1:=nSlices;
  213.   SelectPic(2);
  214.   GetPicSize(w2,h2);
  215.   d2:=nSlices;
  216.   if d1>=d2
  217.     then d3:=d1
  218.     else d3:=d2;
  219.   if d3=0 then begin
  220.     PutMessage('Both images must be stacks.');
  221.     exit;
  222.   end;
  223.   w3:=w1+w2;
  224.   if h1>=h2
  225.     then h3:=h1
  226.     else h3:=h2;
  227.   SetNewSize(w3,h3);
  228.   MakeNewStack('Merged');
  229.   for i:=1 to d3 do begin
  230.     SelectPic(1);
  231.     SelectSlice(1);
  232.     SelectAll;
  233.     Copy;
  234.     DeleteSlice;
  235.     SelectPic(3);
  236.     MakeRoi(0,0,w1,h1);
  237.     Paste;
  238.     SelectPic(2);
  239.     SelectSlice(1);
  240.     SelectAll;
  241.     Copy;
  242.     DeleteSlice;
  243.     SelectPic(3);
  244.     MakeRoi(w1,0,w2,h2);
  245.     Paste;
  246.     if i<d3 then AddSlice;
  247.   end;
  248.   SelectPic(1);
  249.   Dispose;
  250.   SelectPic(1);
  251.   Dispose;
  252.   RestoreState;
  253. end;
  254.  
  255.  
  256. macro '(---'; begin end;
  257.  
  258.  
  259. macro 'Reconstruct One Slice [R]'
  260. begin
  261.   Reslice;
  262. end;
  263.  
  264.  
  265. macro 'Reconstruct Horizontal Set [H]'
  266. var
  267.   i,nImages,step,stack1,stack2,width,height:integer;
  268.   RoiLeft,RoiTop,RoiWidth,RoiHeight,yloc:integer;
  269.   scale:real;
  270.   FirstTime:boolean;
  271. begin
  272.   CheckForStack;
  273.   CheckForSelection;
  274.   SaveState;
  275.   stack1:=PicNumber;
  276.   nImages:=GetNumber('Number of slices to reconstruct:',nSlices);
  277.   scale:=1.0;
  278.   step:=RoiHeight div nImages;
  279.   if odd(RoiWidth) then RoiWidth:=RoiWidth-1;
  280.   FirstTime:=true;
  281.   yloc:=RoiTop+step;
  282.   while yloc<(RoiTop+RoiHeight) do begin
  283.     ChoosePic(stack1);
  284.     MakeLineRoi(RoiLeft,yloc,RoiLeft+RoiWidth,yloc);
  285.     Reslice;
  286.     SelectAll;
  287.     Copy;
  288.     GetPicSize(width,height);
  289.     Dispose;
  290.     if FirstTime then begin
  291.       SetNewSize(width,height);
  292.       MakeNewStack(step:1:2);
  293.       stack2:=PicNumber;
  294.     end;
  295.     ChoosePic(stack2);
  296.     if not FirstTime then AddSlice;
  297.     Paste;
  298.     yloc:=yloc+step;
  299.     FirstTime:=false;
  300.   end;
  301.   SelectPic(stack2);
  302.   KillRoi;
  303.   RestoreState;
  304. end;
  305.  
  306.  
  307. macro 'Horizontal Set to Disk'
  308. var
  309.   i,nImages,step,stack,width,height:integer;
  310.   RoiLeft,RoiTop,RoiWidth,RoiHeight,yloc:integer;
  311.   scale:real;
  312. begin
  313.   CheckForStack;
  314.   CheckForSelection;
  315.   stack:=PicNumber;
  316.   nImages:=GetNumber('Number of slices to reconstruct:',nSlices);
  317.   scale:=1.0;
  318.   step:=RoiHeight div nImages;
  319.   if odd(RoiWidth) then RoiWidth:=RoiWidth-1;
  320.   yloc:=RoiTop+step;
  321.   i:=0;
  322.   while yloc<(RoiTop+RoiHeight) do begin
  323.     ChoosePic(stack);
  324.     MakeLineRoi(RoiLeft,yloc,RoiLeft+RoiWidth,yloc);
  325.     Reslice;
  326.     i:=i+1;
  327.     SaveAs(step:1:2,'-',i:2:0);
  328.     Dispose;
  329.     yloc:=yloc+step;
  330.   end;
  331. end;
  332.  
  333.  
  334. macro 'Reconstruct Vertical Set [V]'
  335. var
  336.   i,nImages,step,stack1,stack2,width,height:integer;
  337.   RoiLeft,RoiTop,RoiWidth,RoiHeight,hloc:integer;
  338.   scale:real;
  339.   FirstTime:boolean;
  340. begin
  341.   CheckForStack;
  342.   CheckForSelection;
  343.   SaveState;
  344.   stack1:=PicNumber;
  345.   nImages:=GetNumber('Number of slices to reconstruct:',nSlices);
  346.   scale:=1.0;
  347.   step:=RoiWidth div nImages;
  348.   if odd(RoiHeight) then RoiHeight:=RoiHeight-1;
  349.   FirstTime:=true;
  350.   hloc:=RoiLeft+step;
  351.   while hloc<(RoiLeft+RoiWidth) do begin
  352.     ChoosePic(stack1);
  353.     MakeLineRoi(hloc,RoiTop,hloc,RoiTop+RoiHeight);
  354.     Reslice;
  355.     SelectAll;
  356.     Copy;
  357.     GetPicSize(width,height);
  358.     Dispose;
  359.     if FirstTime then begin
  360.       SetNewSize(width,height);
  361.       MakeNewStack(step:1:2);
  362.       stack2:=PicNumber;
  363.     end;
  364.     ChoosePic(stack2);
  365.     if not FirstTime then AddSlice;
  366.     Paste;
  367.     hloc:=hloc+step;
  368.     FirstTime:=false;
  369.   end;
  370.   SelectPic(stack2);
  371.   KillRoi;
  372.   RestoreState;
  373. end;
  374.  
  375.  
  376. macro 'Vertical Set to Disk'
  377. var
  378.   i,nImages,step,stack,width,height:integer;
  379.   RoiLeft,RoiTop,RoiWidth,RoiHeight,hloc:integer;
  380.   scale:real;
  381. begin
  382.   CheckForStack;
  383.   CheckForSelection;
  384.   stack:=PicNumber;
  385.   nImages:=GetNumber('Number of slices to reconstruct:',nSlices);
  386.   scale:=1.0;
  387.   step:=RoiWidth div nImages;
  388.   if odd(RoiHeight) then RoiHeight:=RoiHeight-1;
  389.   hloc:=RoiLeft+step;
  390.   i:=0;
  391.   while hloc<(RoiLeft+RoiWidth) do begin
  392.     ChoosePic(stack);
  393.     MakeLineRoi(hloc,RoiTop,hloc,RoiTop+RoiHeight);
  394.     Reslice;
  395.     i:=i+1;
  396.     SaveAs(step:1:2,'-',i:2:0);
  397.     Dispose;
  398.     hloc:=hloc+step;
  399.   end;
  400. end;
  401.  
  402.  
  403.